﻿<%
'''无组件上传类
Class ClassUpLoad
	'总大小限制,单文件大小限制,文件类型,保存路径,自动保存,错误代码,编码
	Private s_totalSize,s_maxSize,s_fileType,s_savePath,s_autoSave,s_error,s_charset
	
	Private s_dicForm, s_binForm, s_binItem, s_strDate,s_lngTime
	
	Public	FormItem,FileItem

	'''构造
	Private Sub Class_Initialize()
		s_error	   = -1
		s_charset  = "UTF-8"
		s_totalSize= 0
		s_maxSize  = 0
		s_fileType = "jpg/gif/bmp/png/rar/zip"
		s_savePath = "/data/upload/"
		s_autoSave = 0
		Dim t_t : t_t = Date()
		s_strDate  = Year(t_t)&Right("0"&Month(t_t),2)&Right("0"&Day(t_t),2)
		s_lngTime  = Clng(Timer()*1000)
		Set s_binForm = Server.CreateObject("ADODB.Stream")
		Set s_binItem = Server.CreateObject("ADODB.Stream")
		Set s_dicForm = Server.CreateObject("Scripting.Dictionary")
		s_dicForm.CompareMode = 1
	End Sub

	'''析构
	Private Sub Class_Terminate()
		s_dicForm.RemoveAll()
		Set s_dicForm = Nothing
		Set s_binItem = Nothing
		If s_binForm.state<>0 Then
			s_binForm.Close()
		End If
		Set s_binForm = nothing
	End Sub
	
	'''获取错误代码
	Public Property Get [Error]()
		[Error] = s_error
	End Property

	'''获取编码
	Public Property Get Charset()
		Charset = s_charset
	End Property
	
	'''设置编码
	'p_s:编码名称
	Public Property Let Charset(Byval p_s)
		s_charset = p_s
	End Property

	'''获取总大小限制
	Public Property Get TotalSize()
		TotalSize = s_totalSize
	End Property
	
	'''设置总大小限制最大字节数
	'p_s:最大字节数
	Public Property Let TotalSize(Byval p_s)
		If IsNumeric(p_s) Then
			s_totalSize = Clng(p_s)
		End If
	End Property

	'''获取每个上传文件的最大字节数
	Public Property Get MaxSize()
		MaxSize = s_maxSize
	End Property
	
	'''设置每个上传文件的最大字节数
	Public Property Let MaxSize(Byval p_s)
		If IsNumeric(p_s) Then
			s_maxSize = Clng(p_s)
		End If
	End Property

	'''获取允许上传的文件类型
	Public Property Get FileType()
		FileType=s_fileType
	End Property
	
	'''设置允许上传的文件类型
	Public Property Let FileType(Byval p_t)
		s_fileType = p_t
	End Property

	'''获取文件存放的路径
	Public Property Get SavePath()
		SavePath = s_savePath
	End Property
	
	'''设置文件存放的路径
	Public Property Let SavePath(Byval p_s)
		s_savePath = Replace(p_s,Chr(0),"")
	End Property

	'''获取是否自动保存
	Public Property Get AutoSave()
		AutoSave = s_autoSave
	End Property
	
	'''设置 Open 方法处理文件的方式
	Public Property Let AutoSave(Byval p_b)
		Select Case p_b
		Case 0,1,2
			s_autoSave = p_b
		End Select
	End Property

	'''格式化的时间字符串
	Private Function timeStr_()
		s_lngTime = s_lngTime + 1
		timeStr_ = s_strDate & Right("00000000"&s_lngTime, 8)
	End Function

	'''判断文件大小\类型的合法性
	'p_z:文件大小
	'p_e:文件类型
	Private Function getFerr_(Byval p_z, Byval p_e)
		Dim t_i : t_i=0
		If p_z>s_maxSize And s_maxSize>0 Then
			If s_error=0 Or s_error=2 Then
				s_error = s_error + 1
			End If
			t_i = t_i + 1
		End If
		If Instr(1,LCase("/"&s_fileType&"/"),LCase("/"&p_e&"/"))=0 And s_fileType<>"" Then
			If s_error<2 Then
				s_error = s_error + 2
			End If
			t_i = t_i + 2
		End If
		getFerr_ = t_i
	End Function
	
	'''
	Private Function binVal2_(Byval p_b)
		Dim t_v,t_i
		t_v = 0
		For t_i = lenb(p_b) To 1 Step -1
			t_v = t_v *256 + Ascb(Midb(p_b,t_i,1))
		Next
		binVal2_ = t_v
	End Function

	'''
	Private Function bin2Val_(Byval p_b)
		Dim t_v,t_i
		t_v = 0
		For t_i = 1 To Lenb(p_b)
			t_v = t_v *256 + Ascb(Midb(p_b,t_i,1))
		Next
		bin2Val_ = t_v
	End Function

	'''
	Private Function num2Str_(Byval p_n, Byval p_b, Byval p_l)
		Dim t_t,t_i
		t_t = ""
		While(p_n >= p_b)
			t_i = p_n Mod p_b
			t_t = t_i & t_t
			p_n = (p_n - t_i) / p_b
		Wend
		num2Str_ = Right(String(p_l, "0") & p_n & t_t, p_l)
	End Function

	'''
	Private Function str2Num_(Byval p_s, Byval p_b)
		Dim t_t, t_i
		t_t = 0 
		For t_i = 1 To Len(p_s)
			t_t = t_t * p_b + Cint(Mid(p_s, t_i, 1))
		Next
		str2Num_ = t_t
	End Function
	
	'''打开对象开始上传，返回本次上传总数据大小
	Public Function Open()
		Open = 0
		If s_error = -1 Then
			s_error = 0
		Else
			Exit Function
		End If
		Dim t_z : t_z = Request.TotalBytes
		If s_totalSize>0 And t_z>s_totalSize Then
			s_error = 5
			Exit Function
		ElseIf t_z<1 Then
			s_error = 4
			Exit Function
		End If
		Dim t_cb : t_cb = 102400
		Dim t_rz : t_rz = 0
		s_binForm.Type = 1
		s_binForm.Open()
		Do
			s_binForm.Write(Request.BinaryRead(t_cb))
			t_rz = t_rz + t_cb
			If t_rz >= t_z Then
				Exit Do
			End If
		Loop
		s_binForm.Position = 0
		Dim t_rd : t_rd = s_binForm.Read()
		Dim t_bc, t_ss, t_is
		t_bc = ChrB(13) & ChrB(10)
		t_is = InstrB(1,t_rd,t_bc) - 1
		t_ss = LeftB(t_rd,t_is)

		Dim strItem,strInam,strFtyp,strPuri,strFnam,strFext,lngFsiz
		Const strSplit="'"">"
		Dim strFormItem,strFileItem,intTemp,strTemp
		Dim p_start : p_start=t_is+2
		Dim p_end
		Do
			p_end = InStrB(p_start,t_rd,t_bc&t_bc)-1
			s_binItem.Type=1
			s_binItem.Open()
			s_binForm.Position=p_start
			s_binForm.CopyTo s_binItem,p_end-p_start
			s_binItem.Position=0
			s_binItem.Type=2
			s_binItem.Charset=s_charset
			strItem = s_binItem.ReadText()
			s_binItem.Close()
			intTemp=Instr(39,strItem,"""")
			strInam=Mid(strItem,39,intTemp-39)
			p_start = p_end + 4
			p_end = InStrB(p_start,t_rd,t_ss)-1
			s_binItem.Type=1
			s_binItem.Open()
			s_binForm.Position=p_start
			lngFsiz=p_end-p_start-2
			s_binForm.CopyTo s_binItem,lngFsiz
			If Instr(intTemp,strItem,"filename=""")<>0 Then
			If Not s_dicForm.Exists(strInam&"_From") Then
				strFileItem=strFileItem&strSplit&strInam
				If s_binItem.Size<>0 Then
					intTemp=intTemp+13
					strFtyp=Mid(strItem,Instr(intTemp,strItem,"Content-Type: ")+14)
					strPuri=Mid(strItem,intTemp,Instr(intTemp,strItem,"""")-intTemp)
					intTemp=InstrRev(strPuri,"\")
					strFnam=Mid(strPuri,intTemp+1)
					s_dicForm.Add strInam&"_Type",strFtyp
					s_dicForm.Add strInam&"_Name",strFnam
					s_dicForm.Add strInam&"_Path",Left(strPuri,intTemp)
					s_dicForm.Add strInam&"_Size",lngFsiz
					If Instr(strFnam,".")<>0 Then
						strFext=Mid(strFnam,InstrRev(strFnam,".")+1)
					Else
						strFext=""
					End If
					Select Case strFtyp
					Case "image/jpeg","image/pjpeg","image/jpg"
						If Lcase(strFext)<>"jpg" Then
							strFext = "jpg"
						End If
						s_binItem.Position=3
						Do While Not s_binItem.EOS
							Do
								intTemp = Ascb(s_binItem.Read(1))
							Loop While intTemp = 255 And Not s_binItem.EOS
							If intTemp < 192 Or intTemp > 195 Then
								s_binItem.read(bin2Val_(s_binItem.Read(2))-2)
							Else
								Exit Do
							End If
							Do
								intTemp = Ascb(s_binItem.Read(1))
							Loop While intTemp < 255 And Not s_binItem.EOS
						Loop
						s_binItem.Read(3)
						s_dicForm.Add strInam&"_Height",bin2Val_(s_binItem.Read(2))
						s_dicForm.Add strInam&"_Width",bin2Val_(s_binItem.Read(2))
					Case "image/gif"
						If Lcase(strFext)<>"gif" Then
							strFext="gif"
						End If
						s_binItem.Position=6
						s_dicForm.Add strInam&"_Width",binVal2_(s_binItem.Read(2))
						s_dicForm.Add strInam&"_Height",binVal2_(s_binItem.Read(2))
					Case "image/png"
						If Lcase(strFext)<>"png" Then
							strFext="png"
						End If
						s_binItem.Position=18
						s_dicForm.Add strInam&"_Width",bin2Val_(s_binItem.Read(2))
						s_binItem.Read(2)
						s_dicForm.Add strInam&"_Height",bin2Val_(s_binItem.Read(2))
					Case "image/bmp"
						If Lcase(strFext)<>"bmp" Then
							strFext="bmp"
						End If
						s_binItem.Position=18
						s_dicForm.Add strInam&"_Width",binVal2_(s_binItem.Read(4))
						s_dicForm.Add strInam&"_Height",binVal2_(s_binItem.Read(4))
					Case "application/x-shockwave-flash"
						If Lcase(strFext)<>"swf" Then
							strFext="swf"
						End If
						s_binItem.Position=0
						If Ascb(s_binItem.Read(1))=70 Then
							s_binItem.Position=8
							strTemp = num2Str_(Ascb(s_binItem.Read(1)), 2 ,8)
							intTemp = str2Num_(Left(strTemp, 5), 2)
							strTemp = Mid(strTemp, 6)
							While (Len(strTemp) < intTemp * 4)
								strTemp = strTemp & num2Str_(Ascb(s_binItem.Read(1)), 2 ,8)
							wend
							Dim t_w, t_h
							t_w = Int(Abs(str2Num_(Mid(strTemp, intTemp + 1, intTemp), 2) - str2Num_(Mid(strTemp, 1, intTemp), 2)) / 20)
							t_h = Int(Abs(str2Num_(Mid(strTemp, 3 * intTemp + 1, intTemp), 2) - str2Num_(Mid(strTemp, 2 * intTemp + 1, intTemp), 2)) / 20)
							s_dicForm.Add strInam&"_Width", t_w
							s_dicForm.Add strInam&"_Height", t_h
						End If
					End Select
					s_dicForm.Add strInam&"_Ext",strFext
					s_dicForm.Add strInam&"_From",p_start
					If s_autoSave<>2 Then
						intTemp=getFerr_(lngFsiz,strFext)
						s_dicForm.Add strInam&"_Err",intTemp
						If intTemp=0 Then
							If s_autoSave=0 Then
								strFnam=timeStr_()
								If strFext<>"" Then
									strFnam=strFnam&"."&strFext
								End If
							End If
							s_binItem.SaveToFile Server.MapPath(s_savePath&strFnam),2
							s_dicForm.Add strInam,strFnam
						End If
					End If
				Else
					s_dicForm.Add strInam&"_Err",-1
				End If
			End If
			Else
				s_binItem.Position=0
				s_binItem.Type=2
				s_binItem.Charset=s_charset
				strTemp=s_binItem.ReadText
				If s_dicForm.Exists(strInam) Then
					s_dicForm(strInam) = s_dicForm(strInam)&","&strTemp
				Else
					strFormItem=strFormItem&strSplit&strInam
					s_dicForm.Add strInam,strTemp
				End If
			End If
			s_binItem.Close()
			p_start = p_end+t_is+2
		Loop Until p_start+3>t_z
		FormItem=Split(strFormItem,strSplit)
		FileItem=Split(strFileItem,strSplit)
		Open = t_z
	End Function

	'''保存表单中 file 域上传的文件，成功保存返回 true，否则返回 false
	'Item 是 file 域名称，Name 是保存的文件名
	Public Function Save(Byval Item,Byval strFnam)
		Save=false
		If s_dicForm.Exists(Item&"_From") Then
			dim intFerr,strFext
			strFext=s_dicForm(Item&"_Ext")
			intFerr=getFerr_(s_dicForm(Item&"_Size"),strFext)
			If s_dicForm.Exists(Item&"_Err") Then
				If intFerr=0 Then
					s_dicForm(Item&"_Err")=0
				End If
			Else
				s_dicForm.Add Item&"_Err",intFerr
			End If
			If intFerr<>0 Then
				Exit Function
			End If
			If VarType(strFnam)=2 Then
				Select Case strFnam
					Case 0:strFnam=timeStr_()
						If strFext<>"" Then
							strFnam=strFnam&"."&strFext
						End If
					Case 1:strFnam=s_dicForm(Item&"_Name")
				End Select
			End If
			s_binItem.Type = 1
			s_binItem.Open
			s_binForm.Position = s_dicForm(Item&"_From")
			s_binForm.CopyTo s_binItem,s_dicForm(Item&"_Size")
			s_binItem.SaveToFile Server.MapPath(s_savePath&strFnam),2
			s_binItem.Close()
			If s_dicForm.Exists(Item) Then
				s_dicForm(Item)=strFnam
			Else
				s_dicForm.Add Item,strFnam
			End If
			Save=true
		End If
	End Function

	'''返回表单中 file 域上传的文件数据流
	'Item 是 file 域名称
	Public Function GetData(Byval Item)
		GetData=""
		If s_dicForm.Exists(Item&"_From") Then
			If getFerr_(s_dicForm(Item&"_Size"),s_dicForm(Item&"_Ext"))<>0 Then
				Exit Function
			End If
			s_binForm.Position = s_dicForm(Item&"_From")
			GetData = s_binForm.Read(s_dicForm(Item&"_Size"))
		End If
	End Function

	'''返回表单中各类域提交（上传）的文本（文件）信息
	'Item 是域名称
	Public Function Form(Byval Item)
		If s_dicForm.Exists(Item) Then
			Form=s_dicForm(Item)
		Else
			Form=""
		End If
	End Function
End Class
%>